home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tpb4_src.zip / KEYSTUFF.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-09-14  |  2.8 KB  |  106 lines
  1. { TPBoard 4.2 Copyright (c) 1987,88 by Jon Schneider & Rick Petersen  
  2.   Portions Copyright (c) 1986,87 by Steve Fox and Les Archambault  
  3.   
  4.   Last modified  ::  9-13-88 8:20 pm 
  5. }
  6.  
  7. {$R-}                             {Range checking off}
  8. {$B-}                             {Boolean complete evaluation off}
  9. {$S-}                             {Stack checking off}
  10. {$I+}                             {I/O checking on}
  11. {$N-}                             {No numeric coprocessor}
  12.  
  13. Unit KeyStuff;
  14.  
  15. Interface
  16.  
  17. Uses TPcrt;
  18.  
  19.  
  20. function StuffKey(St : string)    : string;
  21.  
  22. procedure FlushKey;
  23.  
  24.  
  25.   {==========================================================================}
  26.   
  27.   
  28. Implementation
  29.  
  30.  
  31. const
  32.   BufSeg          = $40;
  33.   BufHeadAddr     = $1A;
  34.   BufTailAddr     = $1C;
  35.   BufBegAddr      = $1E;
  36.   BufEndAddr      = $3C;
  37.   
  38.   
  39.   function StuffChar(Ch : Char)      : Boolean;
  40.     {  This procedure inserts a single character into the keyboard buffer. }
  41.   var
  42.     Tail, Head      : Integer;
  43.     NextPos         : Integer;
  44.     Ch2             : Char;
  45.     
  46.   begin
  47.     inline($fa);                  {disable int's}
  48.     Head := MemW[BufSeg:BufHeadAddr]; { get current head of buffer }
  49.     Tail := MemW[BufSeg:BufTailAddr]; { get current tail of buffer }
  50.     NextPos := Tail+2;
  51.     if NextPos > BufEndAddr then
  52.       NextPos := BufBegAddr;
  53.     if NextPos <> Head then
  54.       begin
  55.         if Ord(Ch) > $7f then
  56.           begin
  57.             Ch2 := Chr(Ord(Ch)-$80);
  58.             Ch := Chr(0);
  59.           end
  60.         else
  61.           Ch2 := Chr(1);
  62.         Mem[BufSeg:Tail] := Ord(Ch); { put character in }
  63.         Mem[BufSeg:Tail+1] := Ord(Ch2); { put harmless scan code in }
  64.         Tail := NextPos;          { increment the tail pointer }
  65.         MemW[BufSeg:BufTailAddr] := Tail; { update actual keyboard tail }
  66.         inline($fb);              { enable int's }
  67.         StuffChar := True;
  68.       end
  69.     else
  70.       begin
  71.         inline($fb);              { enable int's }
  72.         StuffChar := False;
  73.       end;
  74.   end;
  75.   
  76.   
  77.   
  78.   function StuffKey(St : string)    : string;
  79. {  This procedure inserts a string of characters into the keyboard
  80.    buffer, returning either a null string if successful, or a string
  81.   containing what wouldn't fit in the buffer. }
  82.   var
  83.     stuffed         : Boolean;
  84.     
  85.   begin
  86.     if Length(st) > 0 then
  87.       repeat
  88.         stuffed := StuffChar(St[1]);
  89.         if stuffed then
  90.           Delete(st, 1, 1);
  91.       until (not stuffed) or (Length(st) < 1);
  92.     StuffKey := St;
  93.   end;
  94.   
  95.   
  96.   procedure FlushKey;
  97.     {  This procedure removes all characters currently in the keyboard buffer. }
  98.   var
  99.     TempWord        : Word;
  100.   begin
  101.     while CheckKbd(TempWord) do TempWord := ReadKeyWord
  102.   end { FlushKey } ;
  103.   
  104. end.                              { UNIT KbdStuff }
  105. 
  106.